{- Pass False to force looking inside file, for when git checks out
- symlinks as plain files. -}
-getAnnexLinkTarget' :: OsPath -> Bool -> Annex (Maybe S.ByteString)
+getAnnexLinkTarget' :: OsPath -> Bool -> Annex (Maybe LinkTarget)
getAnnexLinkTarget' file coresymlinks = if coresymlinks
then check probesymlink $
return Nothing
getMagicMime :: Magic -> OsPath -> IO (Maybe (MimeType, MimeEncoding))
#ifdef WITH_MAGICMIME
-getMagicMime m f = Just . parse <$> magicConcurrentSafe (magicFile m f)
+getMagicMime m f = Just . parse <$> magicConcurrentSafe (magicFile m (fromOsPath f))
where
parse s =
let (mimetype, rest) = separate (== ';') s
Nothing -> giveup $ "Cannot generate a key for backend " ++
decodeBS (formatKeyVariety (B.backendVariety b))
-getBackend :: FilePath -> Key -> Annex (Maybe Backend)
+getBackend :: OsPath -> Key -> Annex (Maybe Backend)
getBackend file k = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
Just backend -> return $ Just backend
Nothing -> do
- warning $ "skipping " <> QuotedPath (toOsPath file) <> " (" <>
+ warning $ "skipping " <> QuotedPath file <> " (" <>
UnquotedString (unknownBackendVarietyMessage (fromKey keyVariety k)) <> ")"
return Nothing
data FixWhat = FixSymlinks | FixAll
-start :: FixWhat -> SeekInput -> RawFilePath -> Key -> CommandStart
+start :: FixWhat -> SeekInput -> OsPath -> Key -> CommandStart
start fixwhat si file key = do
- currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file
+ currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file'
wantlink <- calcRepo $ gitAnnexLink file key
case currlink of
Just l
- | l /= wantlink -> fixby $ fixSymlink file wantlink
+ | l /= fromOsPath wantlink ->
+ fixby $ fixSymlink file wantlink
| otherwise -> stop
Nothing -> case fixwhat of
FixAll -> fixthin
FixSymlinks -> stop
where
+ file' = fromOsPath file
fixby = starting "fix" (mkActionItem (key, file)) si
fixthin = do
obj <- calcRepo (gitAnnexLocation key)
stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do
thin <- annexThin <$> Annex.getGitConfig
- fs <- liftIO $ catchMaybeIO $ R.getFileStatus file
- os <- liftIO $ catchMaybeIO $ R.getFileStatus obj
+ fs <- liftIO $ catchMaybeIO $ R.getFileStatus file'
+ os <- liftIO $ catchMaybeIO $ R.getFileStatus (fromOsPath obj)
case (linkCount <$> fs, linkCount <$> os, thin) of
(Just 1, Just 1, True) ->
fixby $ makeHardLink file key
fixby $ breakHardLink file key obj
_ -> stop
-breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform
+breakHardLink :: OsPath -> Key -> OsPath -> CommandPerform
breakHardLink file key obj = do
replaceWorkTreeFile file $ \tmp -> do
- mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
+ mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (fromOsPath file)
unlessM (checkedCopyFile key obj tmp mode) $
giveup "unable to break hard link"
thawContent tmp
modifyContentDir obj $ freezeContent obj
next $ return True
-makeHardLink :: RawFilePath -> Key -> CommandPerform
+makeHardLink :: OsPath -> Key -> CommandPerform
makeHardLink file key = do
replaceWorkTreeFile file $ \tmp -> do
- mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
+ mode <- liftIO $ catchMaybeIO $ fileMode
+ <$> R.getFileStatus (fromOsPath file)
linkFromAnnex' key tmp mode >>= \case
LinkAnnexFailed -> giveup "unable to make hard link"
_ -> noop
next $ return True
-fixSymlink :: RawFilePath -> RawFilePath -> CommandPerform
+fixSymlink :: OsPath -> OsPath -> CommandPerform
fixSymlink file link = do
#if ! defined(mingw32_HOST_OS)
-- preserve mtime of symlink
mtime <- liftIO $ catchMaybeIO $ Posix.modificationTimeHiRes
- <$> R.getSymbolicLinkStatus file
+ <$> R.getSymbolicLinkStatus (fromOsPath file)
#endif
replaceWorkTreeFile file $ \tmpfile -> do
- liftIO $ R.createSymbolicLink link tmpfile
+ let tmpfile' = fromOsPath tmpfile
+ liftIO $ R.createSymbolicLink link' tmpfile'
#if ! defined(mingw32_HOST_OS)
- liftIO $ maybe noop (\t -> touch tmpfile t False) mtime
+ liftIO $ maybe noop (\t -> touch tmpfile' t False) mtime
#endif
- stageSymlink file =<< hashSymlink link
+ stageSymlink file =<< hashSymlink link'
next $ return True
+ where
+ link' = fromOsPath link
let (keyname, file) = separate (== ' ') s
if not (null keyname) && not (null file)
then do
- file' <- liftIO $ relPathCwdToFile (toRawFilePath file)
+ file' <- liftIO $ relPathCwdToFile (toOsPath file)
return $ Right (file', keyOpt keyname)
else return $
Left "Expected pairs of key and filename"
inbackend <- inAnnex key
unless inbackend $ giveup $
"key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"
+ let file' = toOsPath file
let ai = mkActionItem (key, file')
starting "fromkey" ai si $
perform matcher key file'
- where
- file' = toRawFilePath file
-- From user input to a Key.
-- User can input either a serialized key, or an url.
Just k -> Right k
Nothing -> Left $ "bad key/url " ++ s
-perform :: AddUnlockedMatcher -> Key -> RawFilePath -> CommandPerform
+perform :: AddUnlockedMatcher -> Key -> OsPath -> CommandPerform
perform matcher key file = lookupKeyNotHidden file >>= \case
- Nothing -> ifM (liftIO $ doesFileExist (fromRawFilePath file))
+ Nothing -> ifM (liftIO $ doesFileExist file)
( hasothercontent
, do
contentpresent <- inAnnex key
else writepointer
, do
link <- calcRepo $ gitAnnexLink file key
- addAnnexLink link file
+ addAnnexLink (fromOsPath link) file
)
next $ return True
)
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Either
-import qualified System.FilePath.ByteString as P
import System.PosixCompat.Files (fileMode, isSymbolicLink, modificationTime)
cmd :: Command
whenM ((==) DeadTrusted <$> lookupTrust u) $
earlyWarning "Warning: Fscking a repository that is currently marked as dead."
-start :: Maybe Remote -> Incremental -> SeekInput -> RawFilePath -> Key -> CommandStart
-start from inc si file key = Backend.getBackend (fromRawFilePath file) key >>= \case
+start :: Maybe Remote -> Incremental -> SeekInput -> OsPath -> Key -> CommandStart
+start from inc si file key = Backend.getBackend file key >>= \case
Nothing -> stop
Just backend -> do
(numcopies, _mincopies) <- getFileNumMinCopies file
go = runFsck inc si (mkActionItem (key, afile)) key
afile = AssociatedFile (Just file)
-perform :: Key -> RawFilePath -> Backend -> NumCopies -> Annex Bool
+perform :: Key -> OsPath -> Backend -> NumCopies -> Annex Bool
perform key file backend numcopies = do
keystatus <- getKeyFileStatus key file
check
pid <- liftIO getPID
t <- fromRepo gitAnnexTmpObjectDir
createAnnexDirectory t
- let tmp = t P.</> "fsck" <> toRawFilePath (show pid) <> "." <> keyFile key
- let cleanup = liftIO $ catchIO (R.removeLink tmp) (const noop)
+ let tmp = t </> literalOsPath "fsck" <> toOsPath (show pid) <> literalOsPath "." <> keyFile key
+ let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
cleanup
cleanup `after` a tmp
- getfile tmp = ifM (checkDiskSpace Nothing (Just (P.takeDirectory tmp)) key 0 True)
+ getfile tmp = ifM (checkDiskSpace Nothing (Just (takeDirectory tmp)) key 0 True)
( ifM (getcheap tmp)
( return (Just (Right UnVerified))
, ifM (Annex.getRead Annex.fast)
)
, return Nothing
)
- getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) nullMeterUpdate (RemoteVerify remote)
+ getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp nullMeterUpdate (RemoteVerify remote)
getcheap tmp = case Remote.retrieveKeyFileCheap remote of
- Just a -> isRight <$> tryNonAsync (a key afile (fromRawFilePath tmp))
+ Just a -> isRight <$> tryNonAsync (a key afile tmp)
Nothing -> return False
startKey :: Maybe Remote -> Incremental -> (SeekInput, Key, ActionItem) -> NumCopies -> CommandStart
check cs = and <$> sequence cs
{- Checks that symlinks points correctly to the annexed content. -}
-fixLink :: Key -> RawFilePath -> Annex Bool
+fixLink :: Key -> OsPath -> Annex Bool
fixLink key file = do
want <- calcRepo $ gitAnnexLink file key
- have <- getAnnexLinkTarget file
+ have <- fmap toOsPath <$> getAnnexLinkTarget file
maybe noop (go want) have
return True
where
| want /= fromInternalGitPath have = do
showNote "fixing link"
createWorkTreeDirectory (parentDir file)
- liftIO $ R.removeLink file
- addAnnexLink want file
+ liftIO $ R.removeLink (fromOsPath file)
+ addAnnexLink (fromOsPath want) file
| otherwise = noop
{- A repository that supports symlinks and is not bare may have in the past
idealloc <- calcRepo (gitAnnexLocation' (const (pure True)) key)
if loc == idealloc
then return True
- else ifM (liftIO $ R.doesPathExist loc)
+ else ifM (liftIO $ R.doesPathExist $ fromOsPath loc)
( moveobjdir loc idealloc
`catchNonAsync` \_e -> return True
, return True
-- Thaw the content directory to allow renaming it.
thawContentDir src
createAnnexDirectory (parentDir destdir)
- liftIO $ renameDirectory
- (fromRawFilePath srcdir)
- (fromRawFilePath destdir)
+ liftIO $ renameDirectory srcdir destdir
-- Since the directory was moved, lockContentForRemoval
-- will not be able to remove the lock file it
-- made. So, remove the lock file here.
mlockfile <- contentLockFile key =<< getVersion
- liftIO $ maybe noop (removeWhenExistsWith R.removeLink) mlockfile
+ liftIO $ maybe noop (removeWhenExistsWith removeFile) mlockfile
freezeContentDir dest
cleanObjectDirs src
return True
verifyLocationLog key keystatus ai = do
obj <- calcRepo (gitAnnexLocation key)
present <- if isKeyUnlockedThin keystatus
- then liftIO (doesFileExist (fromRawFilePath obj))
+ then liftIO (doesFileExist obj)
else inAnnex key
u <- getUUID
checkContentWritePerm obj >>= \case
Nothing -> warning $ "** Unable to set correct write mode for " <> QuotedPath obj <> " ; perhaps you don't own that file, or perhaps it has an xattr or ACL set"
_ -> return ()
- whenM (liftIO $ R.doesPathExist $ parentDir obj) $
+ whenM (liftIO $ doesDirectoryExist $ parentDir obj) $
freezeContentDir obj
{- Warn when annex.securehashesonly is set and content using an
verifyRequiredContent _ _ = return True
{- Verifies the associated file records. -}
-verifyAssociatedFiles :: Key -> KeyStatus -> RawFilePath -> Annex Bool
+verifyAssociatedFiles :: Key -> KeyStatus -> OsPath -> Annex Bool
verifyAssociatedFiles key keystatus file = do
when (isKeyUnlockedThin keystatus) $ do
f <- inRepo $ toTopFilePath file
Database.Keys.addAssociatedFile key f
return True
-verifyWorkTree :: Key -> RawFilePath -> Annex Bool
+verifyWorkTree :: Key -> OsPath -> Annex Bool
verifyWorkTree key file = do
{- Make sure that a pointer file is replaced with its content,
- when the content is available. -}
Just k | k == key -> whenM (inAnnex key) $ do
showNote "fixing worktree content"
replaceWorkTreeFile file $ \tmp -> do
- mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
+ mode <- liftIO $ catchMaybeIO $
+ fileMode <$> R.getFileStatus
+ (fromOsPath file)
ifM (annexThin <$> Annex.getGitConfig)
( void $ linkFromAnnex' key tmp mode
, do
checkKeySize _ KeyUnlockedThin _ = return True
checkKeySize key _ ai = do
file <- calcRepo $ gitAnnexLocation key
- ifM (liftIO $ R.doesPathExist file)
+ ifM (liftIO $ R.doesPathExist (fromOsPath file))
( checkKeySizeOr badContent key file ai
, return True
)
-withLocalCopy :: Maybe RawFilePath -> (RawFilePath -> Annex Bool) -> Annex Bool
+withLocalCopy :: Maybe OsPath -> (OsPath -> Annex Bool) -> Annex Bool
withLocalCopy Nothing _ = return True
withLocalCopy (Just localcopy) f = f localcopy
-checkKeySizeRemote :: Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool
+checkKeySizeRemote :: Key -> Remote -> ActionItem -> OsPath -> Annex Bool
checkKeySizeRemote key remote ai localcopy =
checkKeySizeOr (badContentRemote remote localcopy) key localcopy ai
-checkKeySizeOr :: (Key -> Annex String) -> Key -> RawFilePath -> ActionItem -> Annex Bool
+checkKeySizeOr :: (Key -> Annex String) -> Key -> OsPath -> ActionItem -> Annex Bool
checkKeySizeOr bad key file ai = case fromKey keySize key of
Nothing -> return True
Just size -> do
checkBackend :: Key -> KeyStatus -> AssociatedFile -> Annex Bool
checkBackend key keystatus afile = do
content <- calcRepo (gitAnnexLocation key)
- ifM (liftIO $ R.doesPathExist content)
+ ifM (liftIO $ R.doesPathExist (fromOsPath content))
( ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content))
( nocheck
, do
ai = mkActionItem (key, afile)
-checkBackendRemote :: Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool
+checkBackendRemote :: Key -> Remote -> ActionItem -> OsPath -> Annex Bool
checkBackendRemote key remote ai localcopy =
checkBackendOr (badContentRemote remote localcopy) key localcopy ai
-checkBackendOr :: (Key -> Annex String) -> Key -> RawFilePath -> ActionItem -> Annex Bool
+checkBackendOr :: (Key -> Annex String) -> Key -> OsPath -> ActionItem -> Annex Bool
checkBackendOr bad key file ai =
ifM (Annex.getRead Annex.fast)
( return True
- verified to be correct. The InodeCache is generated again to detect if
- the object file was changed while the content was being verified.
-}
-checkInodeCache :: Key -> RawFilePath -> Maybe InodeCache -> ActionItem -> Annex ()
+checkInodeCache :: Key -> OsPath -> Maybe InodeCache -> ActionItem -> Annex ()
checkInodeCache key content mic ai = case mic of
Nothing -> noop
Just ic -> do
checkKeyNumCopies :: Key -> AssociatedFile -> NumCopies -> Annex Bool
checkKeyNumCopies key afile numcopies = do
let (desc, hasafile) = case afile of
- AssociatedFile Nothing -> (serializeKey' key, False)
+ AssociatedFile Nothing -> (toOsPath (serializeKey'' key), False)
AssociatedFile (Just af) -> (af, True)
locs <- loggedLocations key
(untrustedlocations, otherlocations) <- trustPartition UnTrusted locs
)
else return True
-missingNote :: RawFilePath -> Int -> NumCopies -> String -> String -> StringContainingQuotedPath
+missingNote :: OsPath -> Int -> NumCopies -> String -> String -> StringContainingQuotedPath
missingNote file 0 _ [] dead =
"** No known copies exist of " <> QuotedPath file <> UnquotedString (honorDead dead)
missingNote file 0 _ untrusted dead =
badContent :: Key -> Annex String
badContent key = do
dest <- moveBad key
- return $ "moved to " ++ fromRawFilePath dest
+ return $ "moved to " ++ fromOsPath dest
{- Bad content is dropped from the remote. We have downloaded a copy
- from the remote to a temp file already (in some cases, it's just a
- symlink to a file in the remote). To avoid any further data loss,
- that temp file is moved to the bad content directory unless
- the local annex has a copy of the content. -}
-badContentRemote :: Remote -> RawFilePath -> Key -> Annex String
+badContentRemote :: Remote -> OsPath -> Key -> Annex String
badContentRemote remote localcopy key = do
bad <- fromRepo gitAnnexBadDir
- let destbad = bad P.</> keyFile key
- let destbad' = fromRawFilePath destbad
- movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad'))
+ let destbad = bad </> keyFile key
+ movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
( return False
, do
createAnnexDirectory (parentDir destbad)
liftIO $ catchDefaultIO False $
- ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy)
- ( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad'
+ ifM (isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath localcopy))
+ ( copyFileExternal CopyTimeStamps localcopy destbad
, do
moveFile localcopy destbad
return True
Remote.logStatus NoLiveUpdate remote key InfoMissing
return $ case (movedbad, dropped) of
(True, Right ()) -> "moved from " ++ Remote.name remote ++
- " to " ++ fromRawFilePath destbad
+ " to " ++ fromOsPath destbad
(False, Right ()) -> "dropped from " ++ Remote.name remote
(_, Left e) -> "failed to drop from" ++ Remote.name remote ++ ": " ++ show e
recordStartTime u = do
f <- fromRepo (gitAnnexFsckState u)
createAnnexDirectory $ parentDir f
- liftIO $ removeWhenExistsWith R.removeLink f
- liftIO $ F.withFile (toOsPath f) WriteMode $ \h -> do
+ liftIO $ removeWhenExistsWith removeFile f
+ liftIO $ F.withFile f WriteMode $ \h -> do
#ifndef mingw32_HOST_OS
- t <- modificationTime <$> R.getFileStatus f
+ t <- modificationTime <$> R.getFileStatus (fromOsPath f)
#else
t <- getPOSIXTime
#endif
showTime = show
resetStartTime :: UUID -> Annex ()
-resetStartTime u = liftIO . removeWhenExistsWith R.removeLink
+resetStartTime u = liftIO . removeWhenExistsWith removeFile
=<< fromRepo (gitAnnexFsckState u)
{- Gets the incremental fsck start time. -}
getStartTime u = do
f <- fromRepo (gitAnnexFsckState u)
liftIO $ catchDefaultIO Nothing $ do
- timestamp <- modificationTime <$> R.getFileStatus f
+ timestamp <- modificationTime <$> R.getFileStatus (fromOsPath f)
let fromstatus = Just (realToFrac timestamp)
- fromfile <- parsePOSIXTime <$> F.readFile' (toOsPath f)
+ fromfile <- parsePOSIXTime <$> F.readFile' f
return $ if matchingtimestamp fromfile fromstatus
then Just timestamp
else Nothing
toFilePath (FuzzDir d) = d
isFuzzFile :: FilePath -> Bool
-isFuzzFile f = "fuzzfile_" `isPrefixOf` takeFileName f
+isFuzzFile f = "fuzzfile_" `isPrefixOf` fromOsPath (takeFileName (toOsPath f))
isFuzzDir :: FilePath -> Bool
isFuzzDir d = "fuzzdir_" `isPrefixOf` d
mkFuzzFile :: FilePath -> [FuzzDir] -> FuzzFile
-mkFuzzFile file dirs = FuzzFile $ joinPath (map toFilePath dirs) </> ("fuzzfile_" ++ file)
+mkFuzzFile file dirs = FuzzFile $ fromOsPath $
+ joinPath (map (toOsPath . toFilePath) dirs) </> toOsPath ("fuzzfile_" ++ file)
mkFuzzDir :: Int -> FuzzDir
mkFuzzDir n = FuzzDir $ "fuzzdir_" ++ show n
runFuzzAction :: FuzzAction -> Annex ()
runFuzzAction (FuzzAdd (FuzzFile f)) = do
- createWorkTreeDirectory (parentDir (toRawFilePath f))
+ createWorkTreeDirectory (parentDir (toOsPath f))
n <- liftIO (getStdRandom random :: IO Int)
liftIO $ writeFile f $ show n ++ "\n"
runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $
- removeWhenExistsWith R.removeLink (toRawFilePath f)
+ removeWhenExistsWith removeFile (toOsPath f)
runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $
R.rename (toRawFilePath src) (toRawFilePath dest)
runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $
- removeDirectoryRecursive d
+ removeDirectoryRecursive (toOsPath d)
runFuzzAction (FuzzMoveDir (FuzzDir src) (FuzzDir dest)) = liftIO $
R.rename (toRawFilePath src) (toRawFilePath dest)
runFuzzAction (FuzzPause d) = randomDelay d
case md of
Nothing -> genFuzzAction
Just d -> do
- newd <- liftIO $ newDir (parentDir $ toRawFilePath $ toFilePath d)
+ newd <- liftIO $ newDir (parentDir $ toOsPath $ toFilePath d)
maybe genFuzzAction (return . FuzzMoveDir d) newd
FuzzDeleteDir _ -> do
d <- liftIO existingDir
existingFile 0 _ = return Nothing
existingFile n top = do
dir <- existingDirIncludingTop
- contents <- catchDefaultIO [] (getDirectoryContents dir)
+ contents <- map fromOsPath
+ <$> catchDefaultIO [] (getDirectoryContents (toOsPath dir))
let files = filter isFuzzFile contents
if null files
then do
then return Nothing
else do
i <- getStdRandom $ randomR (0, length dirs - 1)
- existingFile (n - 1) (top </> dirs !! i)
+ existingFile (n - 1) (fromOsPath (toOsPath top </> toOsPath (dirs !! i)))
else do
i <- getStdRandom $ randomR (0, length files - 1)
- return $ Just $ FuzzFile $ top </> dir </> files !! i
+ return $ Just $ FuzzFile $ fromOsPath $
+ toOsPath top </> toOsPath dir </> toOsPath (files !! i)
existingDirIncludingTop :: IO FilePath
existingDirIncludingTop = do
- dirs <- filter isFuzzDir <$> getDirectoryContents "."
+ dirs <- filter (isFuzzDir . fromOsPath)
+ <$> getDirectoryContents (literalOsPath ".")
if null dirs
then return "."
else do
n <- getStdRandom $ randomR (0, length dirs)
- return $ ("." : dirs) !! n
+ return $ fromOsPath $ (literalOsPath "." : dirs) !! n
existingDir :: IO (Maybe FuzzDir)
existingDir = do
go 0 = return Nothing
go n = do
f <- genFuzzFile
- ifM (doesnotexist (toFilePath f))
+ ifM (doesnotexist (toOsPath (toFilePath f)))
( return $ Just f
, go (n - 1)
)
-newDir :: RawFilePath -> IO (Maybe FuzzDir)
+newDir :: OsPath -> IO (Maybe FuzzDir)
newDir parent = go (100 :: Int)
where
go 0 = return Nothing
go n = do
(FuzzDir d) <- genFuzzDir
- ifM (doesnotexist (fromRawFilePath parent </> d))
+ ifM (doesnotexist (parent </> toOsPath d))
( return $ Just $ FuzzDir d
, go (n - 1)
)
-doesnotexist :: FilePath -> IO Bool
-doesnotexist f = isNothing <$> catchMaybeIO (R.getSymbolicLinkStatus (toRawFilePath f))
+doesnotexist :: OsPath -> IO Bool
+doesnotexist f = isNothing <$> catchMaybeIO (R.getSymbolicLinkStatus (fromOsPath f))
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Vector as V
-import qualified System.FilePath.ByteString as P
+import Data.ByteString.Short (fromShort)
import System.PosixCompat.Files (isDirectory)
import Data.Ord
import qualified Data.Semigroup as Sem
Right r -> remoteInfo o r si
Left _ -> Remote.nameToUUID' p >>= \case
([], _) -> do
- relp <- liftIO $ relPathCwdToFile (toRawFilePath p)
+ relp <- liftIO $ relPathCwdToFile (toOsPath p)
lookupKey relp >>= \case
- Just k -> fileInfo o (fromRawFilePath relp) si k
+ Just k -> fileInfo o (fromOsPath relp) si k
Nothing -> treeishInfo o p si
([u], _) -> uuidInfo o u si
(_us, msg) -> noInfo p si msg
-- The string may not really be a file, but use ActionItemTreeFile,
-- rather than ActionItemOther to avoid breaking back-compat of
-- json output.
- let ai = ActionItemTreeFile (toRawFilePath s)
+ let ai = ActionItemTreeFile (toOsPath s)
showStartMessage (StartMessage "info" ai si)
showNote (UnquotedString msg)
showEndFail
fileInfo :: InfoOptions -> FilePath -> SeekInput -> Key -> Annex ()
fileInfo o file si k = do
matcher <- Limit.getMatcher
- let file' = toRawFilePath file
+ let file' = toOsPath file
whenM (matcher $ MatchingFile $ FileInfo file' file' (Just k)) $
showCustom (unwords ["info", file]) si $ do
evalStateT (mapM_ showStat (file_stats file k)) (emptyStatInfo o)
where
desc = "transfers in progress"
line qp uuidmap t i = unwords
- [ fromRawFilePath (formatDirection (transferDirection t)) ++ "ing"
- , fromRawFilePath $ quote qp $ actionItemDesc $ mkActionItem
+ [ decodeBS $ fromShort (formatDirection (transferDirection t)) <> "ing"
+ , decodeBS $ quote qp $ actionItemDesc $ mkActionItem
(transferKey t, associatedFile i)
, if transferDirection t == Upload then "to" else "from"
, maybe (fromUUID $ transferUUID t) Remote.name $
M.lookup (transferUUID t) uuidmap
]
jsonify t i = object $ map (\(k, v) -> (textKey (packString k), v)) $
- [ ("transfer", toJSON' (formatDirection (transferDirection t)))
+ [ ("transfer", toJSON' (fromShort (formatDirection (transferDirection t))))
, ("key", toJSON' (transferKey t))
- , ("file", toJSON' (fromRawFilePath <$> afile))
+ , ("file", toJSON' ((fromOsPath <$> afile) :: Maybe FilePath))
, ("remote", toJSON' (fromUUID (transferUUID t) :: String))
]
where
disk_size = simpleStat "available local disk space" $
calcfree
<$> (lift $ annexDiskReserve <$> Annex.getGitConfig)
- <*> (lift $ inRepo $ getDiskFree . fromRawFilePath . gitAnnexDir)
+ <*> (lift $ inRepo $ getDiskFree . fromOsPath . gitAnnexDir)
<*> mkSizer
where
calcfree reserve (Just have) sizer = unwords
fast <- Annex.getRead Annex.fast
matcher <- Limit.getMatcher
(presentdata, referenceddata, numcopiesstats, repodata) <-
- Command.Unused.withKeysFilesReferencedIn dir initial
+ Command.Unused.withKeysFilesReferencedIn (toOsPath dir) initial
(update matcher fast)
return $ StatInfo
(Just presentdata)
M.fromList $ zip locs (map update locs)
update loc = addKey key (fromMaybe emptyKeyInfo $ M.lookup loc m)
-updateNumCopiesStats :: RawFilePath -> NumCopiesStats -> [UUID] -> Annex NumCopiesStats
+updateNumCopiesStats :: OsPath -> NumCopiesStats -> [UUID] -> Annex NumCopiesStats
updateNumCopiesStats file (NumCopiesStats m) locs = do
have <- trustExclude UnTrusted locs
!variance <- Variance <$> numCopiesCheck' file (-) have
"+ " ++ show (unknownSizeKeys d) ++
" unknown size"
-staleSize :: String -> (Git.Repo -> RawFilePath) -> Stat
+staleSize :: String -> (Git.Repo -> OsPath) -> Stat
staleSize label dirspec = go =<< lift (dirKeys dirspec)
where
go [] = nostat
keysizes keys = do
dir <- lift $ fromRepo dirspec
liftIO $ forM keys $ \k ->
- catchDefaultIO 0 $ getFileSize (dir P.</> keyFile k)
+ catchDefaultIO 0 $ getFileSize (dir </> keyFile k)
aside :: String -> String
aside s = " (" ++ s ++ ")"
where
ww = WarnUnmatchLsFiles "inprogress"
-start :: IsTerminal -> S.Set Key -> SeekInput -> RawFilePath -> Key -> CommandStart
+start :: IsTerminal -> S.Set Key -> SeekInput -> OsPath -> Key -> CommandStart
start isterminal s _si _file k
| S.member k s = start' isterminal k
| otherwise = stop
start' :: IsTerminal -> Key -> CommandStart
start' (IsTerminal isterminal) k = startingCustomOutput k $ do
- tmpf <- fromRawFilePath <$> fromRepo (gitAnnexTmpObjectLocation k)
+ tmpf <- fromRepo (gitAnnexTmpObjectLocation k)
whenM (liftIO $ doesFileExist tmpf) $
- liftIO $ putStrLn (if isterminal then safeOutput tmpf else tmpf)
+ liftIO $ putStrLn $
+ if isterminal
+ then safeOutput (fromOsPath tmpf)
+ else fromOsPath tmpf
next $ return True
printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
printHeader l = liftIO $ putStrLn $ safeOutput $ lheader $ map (\(_, n, t) -> (n, t)) l
-start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> RawFilePath -> Key -> CommandStart
+start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> OsPath -> Key -> CommandStart
start l _si file key = do
ls <- S.fromList <$> keyLocations key
qp <- coreQuotePath <$> Annex.getGitConfig
trust UnTrusted = " (untrusted)"
trust _ = ""
-format :: [(TrustLevel, Present)] -> RawFilePath -> StringContainingQuotedPath
+format :: [(TrustLevel, Present)] -> OsPath -> StringContainingQuotedPath
format remotes file = UnquotedString (thereMap) <> " " <> QuotedPath file
where
thereMap = concatMap there remotes
, usesLocationLog = False
}
-start :: SeekInput -> RawFilePath -> Key -> CommandStart
+start :: SeekInput -> OsPath -> Key -> CommandStart
start si file key = ifM (isJust <$> isAnnexLink file)
( stop
, starting "lock" (mkActionItem (key, file)) si $
)
cont = perform file key
-perform :: RawFilePath -> Key -> CommandPerform
+perform :: OsPath -> Key -> CommandPerform
perform file key = do
lockdown =<< calcRepo (gitAnnexLocation key)
addSymlink file key =<< withTSDelta (liftIO . genInodeCache file)
( breakhardlink obj
, repopulate obj
)
- whenM (liftIO $ R.doesPathExist obj) $
+ whenM (liftIO $ doesFileExist obj) $
freezeContent obj
+ getlinkcount obj = linkCount <$> liftIO (R.getFileStatus (fromOsPath obj))
+
-- It's ok if the file is hard linked to obj, but if some other
-- associated file is, we need to break that link to lock down obj.
- breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (R.getFileStatus obj)) $ do
+ breakhardlink obj = whenM (catchBoolIO $ (> 1) <$> getlinkcount obj) $ do
mfc <- withTSDelta (liftIO . genInodeCache file)
unlessM (sameInodeCache obj (maybeToList mfc)) $ do
modifyContentDir obj $ replaceGitAnnexDirFile obj $ \tmp -> do
fs <- map (`fromTopFilePath` g)
<$> Database.Keys.getAssociatedFiles key
mfile <- firstM (isUnmodified key) fs
- liftIO $ removeWhenExistsWith R.removeLink obj
+ liftIO $ removeWhenExistsWith removeFile obj
case mfile of
Just unmodified ->
ifM (checkedCopyFile key unmodified obj Nothing)
import Data.Time.Clock.POSIX
import Data.Time
import qualified Data.ByteString.Char8 as B8
-import qualified System.FilePath.ByteString as P
import Control.Concurrent.Async
import Command
import Types.TrustLevel
import Utility.DataUnits
import Utility.HumanTime
+import qualified Utility.FileIO as F
data LogChange = Added | Removed
top <- fromRepo Git.repoPath
p <- liftIO $ relPathCwdToFile top
config <- Annex.getGitConfig
- let logfile = p P.</> locationLogFile config key
- getGitLogAnnex [fromRawFilePath logfile] (Param "--remove-empty" : os)
+ let logfile = p </> locationLogFile config key
+ getGitLogAnnex [logfile] (Param "--remove-empty" : os)
-getGitLogAnnex :: [FilePath] -> [CommandParam] -> Annex ([LoggedFileChange Key], IO Bool)
+getGitLogAnnex :: [OsPath] -> [CommandParam] -> Annex ([LoggedFileChange Key], IO Bool)
getGitLogAnnex fs os = do
config <- Annex.getGitConfig
let fileselector = \_sha f ->
- locationLogFileKey config (toRawFilePath f)
- inRepo $ getGitLog Annex.Branch.fullname Nothing fs os fileselector
+ locationLogFileKey config f
+ inRepo $ getGitLog Annex.Branch.fullname Nothing (map fromOsPath fs) os fileselector
showTimeStamp :: TimeZone -> String -> POSIXTime -> String
showTimeStamp zone format = formatTime defaultTimeLocale format
-- and to the trust log.
getlog = do
config <- Annex.getGitConfig
- let fileselector = \_sha f -> let f' = toRawFilePath f in
- case locationLogFileKey config f' of
+ let fileselector = \_sha f ->
+ case locationLogFileKey config f of
Just k -> Just (Right k)
Nothing
- | f' == trustLog -> Just (Left ())
+ | f == trustLog -> Just (Left ())
| otherwise -> Nothing
inRepo $ getGitLog Annex.Branch.fullname Nothing []
[ Param "--date-order"
displaystart uuidmap zone
| gnuplotOption o = do
file <- (</>)
- <$> fromRepo (fromRawFilePath . gitAnnexDir)
- <*> pure "gnuplot"
- liftIO $ putStrLn $ "Generating gnuplot script in " ++ file
- h <- liftIO $ openFile file WriteMode
+ <$> fromRepo gitAnnexDir
+ <*> pure (literalOsPath "gnuplot")
+ liftIO $ putStrLn $ "Generating gnuplot script in " ++ fromOsPath file
+ h <- liftIO $ F.openFile file WriteMode
liftIO $ mapM_ (hPutStrLn h)
[ "set datafile separator ','"
, "set timefmt \"%Y-%m-%dT%H:%M:%S\""
hFlush h
putStrLn $ "Running gnuplot..."
void $ liftIO $ boolSystem "gnuplot"
- [Param "-p", File file]
+ [Param "-p", File (fromOsPath file)]
return (dispst h endaction)
| sizesOption o = do
liftIO $ putStrLn uuidmapheader
| refOption o = catKey (Ref (toRawFilePath file)) >>= display
| otherwise = do
checkNotBareRepo
- seekSingleGitFile file >>= \case
+ seekSingleGitFile (toOsPath file) >>= \case
Nothing -> return False
Just file' -> catKeyFile file' >>= display
-- To support absolute filenames, pass through git ls-files.
-- But, this plumbing command does not recurse through directories.
-seekSingleGitFile :: FilePath -> Annex (Maybe RawFilePath)
+seekSingleGitFile :: OsPath -> Annex (Maybe OsPath)
seekSingleGitFile file
- | isRelative file = return (Just (toRawFilePath file))
+ | isRelative file = return (Just file)
| otherwise = do
- (l, cleanup) <- inRepo (Git.LsFiles.inRepo [] [toRawFilePath file])
+ (l, cleanup) <- inRepo (Git.LsFiles.inRepo [] [file])
r <- case l of
- (f:[]) | takeFileName (fromRawFilePath f) == takeFileName file ->
+ (f:[]) | takeFileName f == takeFileName file ->
return (Just f)
_ -> return Nothing
void $ liftIO cleanup
trustmap <- trustMapLoad
file <- (</>)
- <$> fromRepo (fromRawFilePath . gitAnnexDir)
- <*> pure "map.dot"
+ <$> fromRepo gitAnnexDir
+ <*> pure (literalOsPath "map.dot")
- liftIO $ writeFile file (drawMap rs trustmap umap)
+ liftIO $ writeFile (fromOsPath file) (drawMap rs trustmap umap)
next $
ifM (Annex.getRead Annex.fast)
( runViewer file []
, runViewer file
- [ ("xdot", [File file])
- , ("dot", [Param "-Tx11", File file])
+ [ ("xdot", [File (fromOsPath file)])
+ , ("dot", [Param "-Tx11", File (fromOsPath file)])
]
)
-runViewer :: FilePath -> [(String, [CommandParam])] -> Annex Bool
+runViewer :: OsPath -> [(String, [CommandParam])] -> Annex Bool
runViewer file [] = do
- showLongNote $ UnquotedString $ "left map in " ++ file
+ showLongNote $ UnquotedString $ "left map in " ++ fromOsPath file
return True
runViewer file ((c, ps):rest) = ifM (liftIO $ inSearchPath c)
( do
where
remotecmd = "sh -c " ++ shellEscape
(cddir ++ " && " ++ "git config --null --list")
- dir = fromRawFilePath $ Git.repoPath r
+ dir = fromOsPath $ Git.repoPath r
cddir
| "/~" `isPrefixOf` dir =
let (userhome, reldir) = span (/= '/') (drop 1 dir)
<*> (MatchingUserInfo . addkeysize <$> dataparser)
where
dataparser = UserProvidedInfo
- <$> optinfo "file" (strOption
+ <$> optinfo "file" ((fmap stringToOsPath . strOption)
( long "file" <> metavar paramFile
<> help "specify filename to match against"
))
)
_ -> giveup "--batch is currently only supported in --json mode"
-start :: CandidateVectorClock -> MetaDataOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
+start :: CandidateVectorClock -> MetaDataOptions -> SeekInput -> OsPath -> Key -> CommandStart
start c o si file k = startKeys c o (si, k, mkActionItem (k, afile))
where
afile = AssociatedFile (Just file)
unwrapmeta (f, v) = (fromMetaField f, map fromMetaValue (S.toList v))
showmeta (f, vs) = map ((T.unpack f ++ "=") ++) (map decodeBS vs)
-parseJSONInput :: String -> Annex (Either String (Either RawFilePath Key, MetaData))
+parseJSONInput :: String -> Annex (Either String (Either OsPath Key, MetaData))
parseJSONInput i = case eitherDecode (BU.fromString i) of
Left e -> return (Left e)
Right v -> do
(Just k, _) -> return $
Right (Right k, m)
(Nothing, Just f) -> do
- f' <- liftIO $ relPathCwdToFile (toRawFilePath f)
+ f' <- liftIO $ relPathCwdToFile f
return $ Right (Left f', m)
(Nothing, Nothing) -> return $
Left "JSON input is missing either file or key"
-startBatch :: (SeekInput, (Either RawFilePath Key, MetaData)) -> CommandStart
+startBatch :: (SeekInput, (Either OsPath Key, MetaData)) -> CommandStart
startBatch (si, (i, (MetaData m))) = case i of
Left f -> do
mk <- lookupKeyStaged f
-- by multiple jobs.
void $ includeCommandAction $ update oldkey newkey
-start :: MigrateOptions -> Maybe KeySha -> SeekInput -> RawFilePath -> Key -> CommandStart
+start :: MigrateOptions -> Maybe KeySha -> SeekInput -> OsPath -> Key -> CommandStart
start o ksha si file key = do
forced <- Annex.getRead Annex.force
- v <- Backend.getBackend (fromRawFilePath file) key
+ v <- Backend.getBackend file key
case v of
Nothing -> stop
Just oldbackend -> do
- data cannot get corrupted after the fsck but before the new key is
- generated.
-}
-perform :: Bool -> MigrateOptions -> RawFilePath -> Key -> MigrationRecord -> Backend -> Backend -> CommandPerform
+perform :: Bool -> MigrateOptions -> OsPath -> Key -> MigrationRecord -> Backend -> Backend -> CommandPerform
perform onlytweaksize o file oldkey oldkeyrec oldbackend newbackend = go =<< genkey (fastMigrate oldbackend)
where
go Nothing = stop
import Utility.Tmp
import Utility.Tmp.Dir
import Utility.Process.Transcript
-import qualified Utility.RawFilePath as R
import Data.Char
import qualified Data.ByteString.Lazy.UTF8 as B8
(s, ok) <- case k of
KeyContainer s -> liftIO $ genkey (Param s)
KeyFile f -> do
- createAnnexDirectory (toRawFilePath (takeDirectory f))
- liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
- liftIO $ protectedOutput $ genkey (File f)
+ createAnnexDirectory (takeDirectory f)
+ liftIO $ removeWhenExistsWith removeFile f
+ liftIO $ protectedOutput $ genkey (File (fromOsPath f))
case (ok, parseFingerprint s) of
(False, _) -> giveup $ "uftp_keymgt failed: " ++ s
(_, Nothing) -> giveup $ "Failed to find fingerprint in uftp_keymgt output: " ++ s
-- the names of keys, and would have to be copied, which is too
-- expensive.
starting "sending files" (ActionItemOther Nothing) (SeekInput []) $
- withTmpFile (toOsPath "send") $ \t h -> do
+ withTmpFile (literalOsPath "send") $ \t h -> do
let ww = WarnUnmatchLsFiles "multicast"
(fs', cleanup) <- seekHelper id ww LsFiles.inRepo
=<< workTreeItems ww fs
matcher <- Limit.getMatcher
let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f Nothing) $
- liftIO $ hPutStrLn h o
+ liftIO $ hPutStrLn h (fromOsPath o)
forM_ fs' $ \(_, f) -> do
mk <- lookupKey f
case mk of
Nothing -> noop
- Just k -> withObjectLoc k $
- addlist f . fromRawFilePath
+ Just k -> withObjectLoc k $ addlist f
liftIO $ hClose h
liftIO $ void cleanup
, Param "-k", uftpKeyParam serverkey
, Param "-U", Param (uftpUID u)
-- only allow clients on the authlist
- , Param "-H", Param ("@"++authlist)
+ , Param "-H", Param ("@"++fromOsPath authlist)
-- pass in list of files to send
- , Param "-i", File (fromRawFilePath (fromOsPath t))
+ , Param "-i", File (fromOsPath t)
] ++ ups
liftIO (boolSystem "uftp" ps) >>= showEndResult
next $ return True
(callback, environ, statush) <- liftIO multicastCallbackEnv
tmpobjdir <- fromRepo gitAnnexTmpObjectDir
createAnnexDirectory tmpobjdir
- withTmpDirIn (fromRawFilePath tmpobjdir) (toOsPath "multicast") $ \tmpdir -> withAuthList $ \authlist -> do
- abstmpdir <- liftIO $ absPath (toRawFilePath tmpdir)
- abscallback <- liftIO $ searchPath callback
+ withTmpDirIn tmpobjdir (literalOsPath "multicast") $ \tmpdir -> withAuthList $ \authlist -> do
+ abstmpdir <- liftIO $ absPath tmpdir
+ abscallback <- liftIO $ searchPath (fromOsPath callback)
let ps =
-- Avoid it running as a daemon.
[ Param "-d"
, Param "-k", uftpKeyParam clientkey
, Param "-U", Param (uftpUID u)
-- Only allow servers on the authlist
- , Param "-S", Param authlist
+ , Param "-S", Param (fromOsPath authlist)
-- Receive files into tmpdir
-- (it needs an absolute path)
- , Param "-D", File (fromRawFilePath abstmpdir)
+ , Param "-D", File (fromOsPath abstmpdir)
-- Run callback after each file received
-- (it needs an absolute path)
- , Param "-s", Param (fromMaybe callback abscallback)
+ , Param "-s", Param (fromOsPath $ fromMaybe callback abscallback)
] ++ ups
runner <- liftIO $ async $
hClose statush
`after` boolSystemEnv "uftpd" ps (Just environ)
- mapM_ storeReceived . lines =<< liftIO (hGetContents statush)
+ mapM_ storeReceived . map toOsPath . lines
+ =<< liftIO (hGetContents statush)
showEndResult =<< liftIO (wait runner)
next $ return True
where
ai = ActionItemOther Nothing
si = SeekInput []
-storeReceived :: FilePath -> Annex ()
+storeReceived :: OsPath -> Annex ()
storeReceived f = do
- case deserializeKey (takeFileName f) of
+ case deserializeKey' (fromOsPath (takeFileName f)) of
Nothing -> do
- warning $ "Received a file " <> QuotedPath (toRawFilePath f) <> " that is not a git-annex key. Deleting this file."
- liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
+ warning $ "Received a file " <> QuotedPath f <> " that is not a git-annex key. Deleting this file."
+ liftIO $ removeWhenExistsWith removeFile f
Just k -> void $ logStatusAfter NoLiveUpdate k $
getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $
liftIO $ catchBoolIO $ do
- R.rename (toRawFilePath f) dest
+ renameFile f dest
return True
-- Under Windows, uftp uses key containers, which are not files on the
-- filesystem.
-data UftpKey = KeyFile FilePath | KeyContainer String
+data UftpKey = KeyFile OsPath | KeyContainer String
uftpKeyParam :: UftpKey -> CommandParam
-uftpKeyParam (KeyFile f) = File f
+uftpKeyParam (KeyFile f) = File (fromOsPath f)
uftpKeyParam (KeyContainer s) = Param s
uftpKey :: Annex UftpKey
u <- getUUID
return $ KeyContainer $ "annex-" ++ fromUUID u
#else
-uftpKey = KeyFile <$> credsFile "multicast"
+uftpKey = KeyFile <$> credsFile (literalOsPath "multicast")
#endif
-- uftp needs a unique UID for each client and server, which
uftpUID :: UUID -> String
uftpUID u = "0x" ++ (take 8 $ show $ sha2_256 $ B8.fromString (fromUUID u))
-withAuthList :: (FilePath -> Annex a) -> Annex a
+withAuthList :: (OsPath -> Annex a) -> Annex a
withAuthList a = do
m <- knownFingerPrints
- withTmpFile (toOsPath "authlist") $ \t h -> do
+ withTmpFile (literalOsPath "authlist") $ \t h -> do
liftIO $ hPutStr h (genAuthList m)
liftIO $ hClose h
- a (fromRawFilePath (fromOsPath t))
+ a t
genAuthList :: M.Map UUID Fingerprint -> String
genAuthList = unlines . map fmt . M.toList
addViewMetaData v f k = starting "metadata" ai si $
next $ changeMetaData k $ fromView v f
where
- ai = mkActionItem (k, toRawFilePath f)
+ ai = mkActionItem (k, f)
si = SeekInput []
removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart
removeViewMetaData v f k = starting "metadata" ai si $
next $ changeMetaData k $ unsetMetaData $ fromView v f
where
- ai = mkActionItem (k, toRawFilePath f)
+ ai = mkActionItem (k, f)
si = SeekInput []
changeMetaData :: Key -> MetaData -> CommandCleanup
-}
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
module Git.Types where
instance FromConfigValue String where
fromConfigValue = decodeBS . fromConfigValue
+#ifdef WITH_OSPATH
instance FromConfigValue OsPath where
fromConfigValue v = toOsPath (fromConfigValue v :: S.ByteString)
+#endif
instance Show ConfigValue where
show = fromConfigValue
import Control.Applicative
import qualified Data.Map as M
import qualified Data.Vector as V
+import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Aeson.KeyMap as HM
import System.IO
j = toJSON' $ JSONActionItem
{ itemCommand = Just command
, itemKey = key
- , itemFile = fromOsPath <$> file
+ , itemFile = file
, itemUUID = Nothing
, itemFields = Nothing :: Maybe Bool
, itemSeekInput = si
j = toJSON' $ JSONActionItem
{ itemCommand = Just command
, itemKey = actionItemKey ai
- , itemFile = fromOsPath <$> actionItemFile ai
+ , itemFile = actionItemFile ai
, itemUUID = actionItemUUID ai
, itemFields = Nothing :: Maybe Bool
, itemSeekInput = si
data JSONActionItem a = JSONActionItem
{ itemCommand :: Maybe String
, itemKey :: Maybe Key
- , itemFile :: Maybe FilePath
+ , itemFile :: Maybe OsPath
, itemUUID :: Maybe UUID
, itemFields :: Maybe a
, itemSeekInput :: SeekInput
Just k -> Just $ "key" .= toJSON' k
Nothing -> Nothing
, case itemFile i of
- Just f -> Just $ "file" .= toJSON' f
+ Just f ->
+ let f' = (fromOsPath f) :: S.ByteString
+ in Just $ "file" .= toJSON' f'
Nothing -> Nothing
, case itemFields i of
Just f -> Just $ "fields" .= toJSON' f
parseJSON (Object v) = JSONActionItem
<$> (v .:? "command")
<*> (maybe (return Nothing) parseJSON =<< (v .:? "key"))
- <*> (v .:? "file")
+ <*> (fmap stringToOsPath <$> (v .:? "file"))
<*> (v .:? "uuid")
<*> (v .:? "fields")
-- ^ fields is used for metadata, which is currently the
checkbackend :: FilePath -> Types.Backend -> Assertion
checkbackend file expected = do
- b <- annexeval $ maybe (return Nothing) (Backend.getBackend file)
- =<< Annex.WorkTree.lookupKey (toOsPath file)
+ let file' = toOsPath file
+ b <- annexeval $ maybe (return Nothing) (Backend.getBackend file')
+ =<< Annex.WorkTree.lookupKey file'
assertEqual ("backend for " ++ file) (Just expected) b
checkispointerfile :: FilePath -> Assertion
- Licensed under the GNU AGPL version 3 or higher.
-}
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP #-}
module Types.UUID where
import Control.DeepSeq
import qualified Data.Semigroup as Sem
+import Common
import Git.Types (ConfigValue(..))
-import Utility.FileSystemEncoding
import Utility.QuickCheck
import Utility.Aeson
-import Utility.OsPath
import qualified Utility.SimpleProtocol as Proto
-- A UUID is either an arbitrary opaque string, or UUID info may be missing.
| SB.null b = NoUUID
| otherwise = UUID (SB.fromShort b)
+#ifdef WITH_OSPATH
-- OsPath is a ShortByteString internally, so this is the most
-- efficient conversion.
instance FromUUID OsPath where
instance ToUUID OsPath where
toUUID s = toUUID (fromOsPath s :: SB.ShortByteString)
+#endif
instance FromUUID String where
fromUUID s = decodeBS (fromUUID s)
module Utility.OsString (
module X,
- length
+ length,
+#ifndef WITH_OSPATH
+ toChar,
+#endif
) where
#ifdef WITH_OSPATH
#else
import Data.ByteString as X hiding (length)
import Data.ByteString (length)
+import Data.Char
+import Data.Word
+import Prelude (fromIntegral, (.))
+
+toChar :: Word8 -> Char
+toChar = chr . fromIntegral
#endif
import Data.Char
import qualified Data.ByteString as S
+#ifdef WITH_OSPATH
+import qualified Utility.OsString as OS
+import Utility.OsPath
+#endif
+
class SafeOutputtable t where
safeOutput :: t -> t
instance SafeOutputtable S.ByteString where
safeOutput = S.filter (safeOutputChar . chr . fromIntegral)
+#ifdef WITH_OSPATH
+instance SafeOutputtable OsString where
+ safeOutput = OS.filter (safeOutputChar . toChar)
+#endif
+
safeOutputChar :: Char -> Bool
safeOutputChar c
| not (isControl c) = True
projects / git-annex.git / commitdiff